home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / 2.01 sources / Library-2.01 / Interfaces / picker.lisp < prev    next >
Encoding:
Text File  |  1993-09-16  |  3.0 KB  |  113 lines  |  [TEXT/CCL2]
  1.  
  2. (in-package :traps)             ; 
  3. ; Created: Friday, October 20, 1989 at 8:56 AM
  4. ;     Picker.p
  5. ;     Pascal Interface to the Macintosh Libraries
  6. ; 
  7. ;     Copyright Apple Computer, Inc.    1987-1989
  8. ;     All rights reserved
  9. ; 
  10.  
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;
  12. ;;
  13. ;; Modification History
  14. ;;
  15. ;; 04/28/93 mwp Release
  16. ;; 04/27/92 bill :signed-integer -> :unsigned-integer where appropriate
  17. ;;
  18.  
  19. ; $IFC UNDEFINED UsingIncludes
  20. ; $SETC UsingIncludes := 0
  21. ; $ENDC
  22.  
  23. ; $IFC NOT UsingIncludes
  24.  
  25. ; $ENDC
  26.  
  27. ; $IFC UNDEFINED UsingPicker
  28. ; $SETC UsingPicker := 1
  29.  
  30. ; $I+
  31. ; $SETC PickerIncludes := UsingIncludes
  32. ; $SETC UsingIncludes := 1
  33. ; $IFC UNDEFINED UsingQuickdraw
  34.  
  35. (require-interface 'QUICKDRAW)  ; $I $$Shell(PInterfaces)Quickdraw.p
  36. ; $ENDC
  37. ; $SETC UsingIncludes := PickerIncludes
  38.  
  39. ; 
  40. ; 
  41. ;  
  42.  
  43. (defconstant $MaxSmallFract #xffff); Maximum small fract value, as long
  44.  
  45. (def-mactype :smallfract (find-mactype :unsigned-integer))
  46.  
  47. (defrecord HSVColor 
  48.    (hue :unsigned-integer)         ; Fraction of circle, red at 0
  49.    (saturation :unsigned-integer)  ; 0-1, 0 for gray, 1 for pure color
  50.    (value :unsigned-integer)       ; 0-1, 0 for black, 1 for max intensity
  51.    )
  52.  
  53. ;  For developmental simplicity in switching between the HLS and HSVmodels, HLS
  54. ;  is reordered into HSL.  Thus both models start with hue and saturation values;
  55. ;  value/lightness/brightness is last. 
  56. (defrecord HSLColor 
  57.    (hue :unsigned-integer)        ; Fraction of circle, red at 0
  58.    (saturation :unsigned-integer) ; 0-1, 0 for gray, 1 for pure color
  59.    (lightness :unsigned-integer)  ; 0-1, 0 for black, 1 for white
  60.    )
  61.  
  62. (defrecord CMYColor 
  63.    (cyan :unsigned-integer)
  64.    (magenta :unsigned-integer)
  65.    (yellow :unsigned-integer)
  66.    )
  67.  
  68.  
  69. (deftrap _fix2smallfract ((f :signed-long))
  70.    (:stack :unsigned-integer)
  71.    (:stack-trap #xA82E f (1 :signed-integer)))
  72.  
  73. (deftrap _smallfract2fix ((s :unsigned-integer))
  74.    (:stack :signed-long)
  75.    (:stack-trap #xA82E s (2 :signed-integer)))
  76.  
  77. (deftrap _cmy2rgb ((ccolor :cmycolor) (rcolor (:pointer :rgbcolor)))
  78.    nil
  79.    (:stack-trap #xA82E ccolor rcolor (3 :signed-integer)))
  80.  
  81. (deftrap _rgb2cmy ((rcolor :rgbcolor) (ccolor (:pointer :cmycolor)))
  82.    nil
  83.    (:stack-trap #xA82E rcolor ccolor (4 :signed-integer)))
  84.  
  85. (deftrap _hsl2rgb ((hcolor :hslcolor) (rcolor (:pointer :rgbcolor)))
  86.    nil
  87.    (:stack-trap #xA82E hcolor rcolor (5 :signed-integer)))
  88.  
  89. (deftrap _rgb2hsl ((rcolor :rgbcolor) (hcolor (:pointer :hslcolor)))
  90.    nil
  91.    (:stack-trap #xA82E rcolor hcolor (6 :signed-integer)))
  92.  
  93. (deftrap _hsv2rgb ((hcolor :hsvcolor) (rcolor (:pointer :rgbcolor)))
  94.    nil
  95.    (:stack-trap #xA82E hcolor rcolor (7 :signed-integer)))
  96.  
  97. (deftrap _rgb2hsv ((rcolor :rgbcolor) (hcolor (:pointer :hsvcolor)))
  98.    nil
  99.    (:stack-trap #xA82E rcolor hcolor (8 :signed-integer)))
  100.  
  101. (deftrap _getcolor ((where :point) (prompt (:string 255)) (incolor :rgbcolor) (outcolor (:pointer :rgbcolor)))
  102.    (:stack :boolean)
  103.    (:stack-trap #xA82E where prompt incolor outcolor (9 :signed-integer)))
  104.  
  105. ; $ENDC                         ;  UsingPicker 
  106.  
  107. ; $IFC NOT UsingIncludes
  108.  
  109. ; $ENDC
  110.  
  111.  
  112. (export '($maxsmallfract))
  113. (provide-interface 'Picker)